The CICA Windows Explosion!/The CICA Windows Explosion! - Disc 2.iso/programr/wpjv1n2.zip/D&DSERV.PAS

Pascal/Delphi Source File | 1993-01-31 | 5KB | 196 lines

(*****************************************)
(*                                       *)
(*   D&D-Server (d&dserv.pas)            *)
(*                                       *)
(*   A simple app to demonstrate the     *)
(*   programming of a Drag&Drop-server   *)
(*                                       *)
(*   Copyright (c) 1992,93 by A. Furrer  *)
(*                                       *)
(*   This program requires Windows 3.1   *)
(*****************************************)

program DDServ;

uses Strings, WinTypes, WinProcs, WObjects;

const ws_Ex_AcceptFiles = $00000010;
      wm_DropFiles      = $0233;


(* These files we want to drop to a D&D-Client *)

const s : array[1..3,0..255] of char=('C:\autoexec.bat',
                                      'C:\config.sys',
                                      'C:\dos\command.com');

(****************************************************)
(* DragDropStruct                                   *)
(*                                                  *)
(* This is the Drag&Drop structure used by Windows. *)
(* The format is NOT documented so it can change    *)
(* in the next release of Wndows.                   *)
(****************************************************)

type PDragDropStruct =^TDragDropStruct;
     TDragDropStruct = record
       DataOffset      : word;
       DropPoint       : TPoint;
       DropInNonClient : bool;
       Data            : array[0..0] of char;
     end;

(****************)
(* Mainwindow   *)
(****************)

type
  PMainwindow = ^TMainwindow;
  TMainwindow =object(TWindow)
    Drag : boolean;
    constructor Init(AParent: PWindowsObject; ATitle: PChar);
    procedure WMLButtonDown(var Msg : TMessage); virtual wm_first +
 wm_LButtonDown;
    procedure WMMouseMove(var Msg : TMessage); virtual wm_first + wm_MouseMove;
    procedure WMLButtonUp(var Msg : TMessage); virtual wm_first + wm_LButtonUp;
  end;


constructor TMainwindow.Init;
begin
  TWindow.Init(AParent,ATitle);
  Drag:=false;
end;

procedure TMainwindow.WMLButtonDown;
begin
  (* Now be begin to Drag&Drop        *)
  (* and we have to capture the mouse *)
  Drag:=true;
  SetCapture(HWindow);
end;

procedure TMainwindow.WMMouseMove;
var DragWnd : HWnd;
    Point : TPoint;
begin
  (* if we do Drag&Drop *)
  if Drag then begin

    (* get the window under the cursor      *)
    Point.X:=LoWord(GetMessagePos);
    Point.Y:=HiWord(GetMessagePos);
    DragWnd:=WindowFromPoint(Point);

    (* and test if it accepts dropped files *)
    if GetWindowLong(DragWnd,gwl_ExStyle) and
 ws_Ex_AcceptFiles=ws_Ex_AcceptFiles then

    (* set the cursor to a cross            *)
      SetCursor(LoadCursor(0,idc_Cross))
    else

    (* set the default cursor               *)
      SetCursor(LoadCursor(0,idc_Arrow))
  end;
end;

procedure TMainwindow.WMLButtonUp;
var DropWnd : HWnd;
    Point : TPoint;
    DataHandle : THandle;
    DataPtr,p : PChar;
    l : longint;
    i : word;
begin
  (* if we do Drag&Drop *)
  if Drag then begin

    (* get the window under the cursor  *)
    Point.X:=LoWord(GetMessagePos);
    Point.Y:=HiWord(GetMessagePos);
    DropWnd:=WindowFromPoint(Point);

    (* and test if it accepts dropped files *)
    if GetWindowLong(DropWnd,gwl_ExStyle) and
 ws_Ex_AcceptFiles=ws_Ex_AcceptFiles then begin

      (* Count the length of the data   *)
      l:=0;
      for i:=1 TO 3 do
        l:=l+StrLen(s[i])+1;

      (* and allocate memory            *)
      DataHandle:=GlobalAlloc(gmem_DDEShare,sizeof(TDragDropStruct)+l);

      (* To set the data we have to     *)
      (* lock the memory                *)
      DataPtr:=GlobalLock(DataHandle);

      (* fill in the Drag&Drop structur *)
      with PDragDropStruct(DataPtr)^ do begin
        DataOffset:=Data-DataPtr;

 DropInNonClient:=(DefWindowProc(DropWnd,wm_NCHitTest,0,longint(Point))<>htClien
 t);
        ScreenToClient(DropWnd,Point);
        DropPoint   :=Point;
      end;

      (* now we set the data            *)
      p:=PDragDropStruct(DataPtr)^.Data;
      for i:=1 to 3 do begin
        StrCopy(p,s[i]);
        p:=p+StrLen(s[i])+1;
      end;

      (* mark the end of the data       *)
      p^:=#0;

      (* and unlock the memory          *)
      GlobalUnlock(DataHandle);


      (* post the wm_DropFiles message  *)
      (* to the window under the cursor *)
      PostMessage(DropWnd,wm_DropFiles,DataHandle,0);

      (* set the default cursor and     *)
      (* release the capture            *)
      SetCursor(LoadCursor(0,idc_Arrow));
      ReleaseCapture;
      Drag:=false;
    end;
  END;
end;


(**********************)
(* TDDServApplication *)
(**********************)

type
   TDDServApplication =
     object(TApplication)
       procedure InitMainWindow; virtual;
     end;

procedure TDDServApplication.InitMainWindow;
begin
  MainWindow := New(PMainwindow,Init(nil, 'D&DServer'));
end;

(***************)
(* Mainprogram *)
(***************)

var
   Prg : TDDServApplication;
begin
  Prg.Init('D&DServer');
  Prg.Run;
  Prg.Done;
end.